home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / swag / win-os2.swg / 0008_Loading .BMP.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-05-25  |  3.4 KB  |  125 lines
  1. {************************************************}
  2. {                                                }
  3. {   Turbo Pascal for Windows                     }
  4. {   Demo unit                                    }
  5. {   Copyright (c) 1991 by Borland International  }
  6. {                                                }
  7. {************************************************}
  8.  
  9. {$R-}
  10.  
  11. unit LoadBMPs;
  12.  
  13. interface
  14.  
  15. uses WinProcs, WinTypes, Strings, WinDos;
  16.   { ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ I do not have these units!!! }
  17.  
  18. function LoadBMP(Name: PChar; Window: hWnd; var DibPal: Word;
  19.  var Width, Height: LongInt): hBitMap;
  20.  
  21. implementation
  22.  
  23. function CreateBIPalette(BI: PBitMapInfoHeader): HPalette;
  24. type
  25.  ARGBQuad = Array[1..5000] of TRGBQuad;
  26. var
  27.  RGB: ^ARGBQuad;
  28.  NumColors: Word;
  29.  Pal: PLogPalette;
  30.  hPal: hPalette;
  31.  I: Integer;
  32. begin
  33.  CreateBiPalette := 0;
  34.  RGB := Ptr(Seg(BI^), Ofs(BI^)+BI^.biSize);
  35.  if BI^.biBitCount<24 then
  36.  begin
  37.    NumColors:= 1 shl BI^.biBitCount;
  38.    if NumColors<>0 then
  39.    begin
  40.      GetMem(Pal, SizeOf(PLogPalette)+NumColors*SizeOf(TPaletteEntry));
  41.      Pal^.palNumEntries := NumColors;
  42.      Pal^.palVersion := $300;
  43.      for I := 0 to NumColors-1 do
  44.      begin
  45.        Pal^.palPalEntry[I].peRed := RGB^[I].rgbRed;
  46.        Pal^.palPalEntry[I].peGreen := RGB^[I].rgbGreen;
  47.        Pal^.palPalEntry[I].peBlue := RGB^[I].rgbBlue;
  48.        Pal^.palPalEntry[I].peFlags := 0;
  49.      end;
  50.      hPal := CreatePalette(Pal^);
  51.      FreeMem(Pal, SizeOf(PLogPalette) + NumColors * SizeOf(TPaletteEntry));
  52.      CreateBiPalette := hPal;
  53.    end;
  54.  end;
  55. end;
  56.  
  57. function LoadBMP(Name: PChar; Window: hWnd; var DibPal: Word;
  58.  var Width, Height: LongInt): hBitMap;
  59. var
  60.  BitMapFileHeader: TBitMapFileHeader;
  61.  DibSize, ReadSize, ColorTableSize, TempReadSize: LongInt;
  62.  DIB: PBitMapInfoHeader;
  63.  TempDib: Pointer;
  64.  Bits: Pointer;
  65.  F: File;
  66.  BitMap: hBitMap;
  67.  Handle: Word;
  68.  DC: hDC;
  69.  OldCursor: HCursor;
  70. begin
  71.  Assign(F, Name);
  72.  {$I-}Reset(F, 1);{$I+}
  73.  if IOResult<>0 then
  74.  begin
  75.    LoadBMP := 0;
  76.    Exit;
  77.  end;
  78.  OldCursor := SetCursor(LoadCursor(0, IDC_Wait));
  79.  BlockRead(F, BitMapFileHeader, SizeOf(BitMapFileHeader));
  80.  DibSize := BitMapFileHeader.bfSize - BitMapFileHeader.bfOffBits;
  81.  ReadSize := LongInt(BitMapFileHeader.bfSize) - SizeOf(BitMapFileHeader);
  82.  Handle := GlobalAlloc(GMem_Moveable, ReadSize);
  83.  DIB := GlobalLock(Handle);
  84.  TempReadSize := ReadSize;
  85.  TempDib := Dib;
  86.  while TempReadSize > 0 do
  87.  begin
  88.    if TempReadSize > $8000 then
  89.    begin
  90.      BlockRead(F, TempDIB^, $8000);
  91.      if Ofs(TempDib^) = $8000 then
  92.         TempDib := Ptr(Seg(TempDib^) + 8, 0)
  93.      else
  94.         TempDib := Ptr(Seg(TempDib^), $8000);
  95.    end
  96.    else
  97.      BlockRead(F, TempDIB^, TempReadSize);
  98.    Dec(TempReadSize, $8000);
  99.  end;
  100.  if DIB^.biBitCount = 24 then
  101.    ColorTableSize := 0
  102.  else
  103.    ColorTableSize := LongInt(1) shl DIB^.biBitCount * SizeOf(TRGBQuad);
  104.  Bits := Ptr(Seg(DIB^), Ofs(DIB^) + DIB^.biSize + ColorTableSize);
  105.  Close(F);
  106.  DC := GetDC(Window);
  107.  DibPal := CreateBIPalette(DIB);
  108.  if DibPal = 0 then
  109.  begin
  110.    SelectPalette(DC, DibPal, false);
  111.    RealizePalette(DC);
  112.  end;
  113.  BitMap := CreateDIBitMap(DC, DIB^, cbm_Init, Bits, PBitMapInfo(Dib)^,
  114.    dib_RGB_Colors);
  115.  Height := DIB^.biHeight;
  116.  Width := DIB^.biWidth;
  117.  ReleaseDC(Window, DC);
  118.  GlobalUnLock(Handle);
  119.  GlobalFree(Handle);
  120.  LoadBMP := BitMap;
  121.  SetCursor(OldCursor);
  122. end;
  123.  
  124. end.
  125.